#!/usr/bin/perl
use strict;
use warnings;
use encoding 'utf8';
use utf8;
use feature 'unicode_strings';
use Tie::File;

open STDERR, '>token_unicode_errors.txt' or die $!;
print "Next: Extract lexical entries\n";
#<stdin>;
print "Working...\n";
#&extract_lexical_entries;
print "Einträge exrtahiert.\n\n";

print "Next: Build tokenlist:\n";
#<stdin>;
print "Working...\n";
#&build_tokenlist;
print "Tokenlist built.\n\n";

print "Next: Clean slices:\n";
#<stdin>;
print "Working...\n";
&clean_slices;
&clean_slices2;
print "Slices cleaned.\n";

print "Next: Build TNT-INPUT\n";
#<stdin>;
print "Working...\n";
&build_tnt_input;
print "All done!\n";
close STDERR;


sub extract_lexical_entries{ #Extract lexical entries from lexicon
	open TRIMMED, ">:utf8","lexicon_trim.tdl" or die $!;
	open LEXICON,  "<:utf8", "lexicon.tdl" or die $!;
	my $count = 0;
	while (<LEXICON>){
		chomp;
		print "Extract lexical entries...\t".$count."\n";
		if($_ =~ m/^(.*)\s\:=\s([1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ.ß abcdefghijklmnopqrstuvwxyzäüöÄÜÖ_-]+)\s/){ #abbruch-n := count-noun-le &
			#print $1."\t".$2."\n";	
			print TRIMMED $1."\t".$2."\n";
			$count++;
		}		
	}
	close TRIMMED;
	close LEXICON;
}

sub build_tokenlist{ #Searches results for Form and pos-tag
	my $derivation=10;
	my $parse=0;
	my $result=1;
	my $count=0;
	my $tokencount=0;
	
	#(80 nach_sdepr-adv-mod -1.23159 0 1 ("nach" 272 "token
	my $interesting_parts = qr/
		\(													#(
		\d+													#80
		\s 													# 
		([1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ.,:;!ß abcdefghijklmnopqrstuvwxyzäüöÄÜÖ_-]+)				    #nach_sdepr-adv-mod
		\s 													#
		-?\d+\.?\d*											#-1.23159
		\s 													#
		\d+													#0
		\s 													#
		\d+													#1
		\s 													#
		\(													#(
		"													#"
		([1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ.,:;!ß abcdefghijklmnopqrstuvwxyzäüöÄÜÖ_-]+)				#nach
		"													#"
		\s 													#
		\d+													#272
		\s 													#
		"													#"
		token												#token
		 /x;
	open IDS, ">:utf8","parse_resultid.txt" or die $!;
	open TOKENLIST, ">tokenlist_gold.txt" or die $!;
	open RESULT,  "<:utf8", "result" or die $!;
	#open RESULT,  "<results.txt" or die $!;
	#print IDS "Parse\tResult-ID\n";
	my @fields;
	while (<RESULT>){ #Read next sentence (line)
		chomp;
		@fields=split(/@/, $_,); #Split at @
		print IDS $fields[$parse]."\t".$fields[$result]."\n";
		#print $fields[$parse]."\t".$fields[$result]."\n";
		my @matches;
		push @matches, [$1, $2] while $fields[$derivation] =~ m/$interesting_parts/gi; #Match according to regex
		for my $i ( 0 .. $#matches ) { #Put matches in file
			$tokencount++;
			print "Build tokenlist...\t$tokencount\n";
			my $aref = $matches[$i];
			my $n = @$aref - 1;
			for my $j ( 0 .. $n ) {
				if ($j<$n){
					#print "$matches[$i][$j]\t";
					print TOKENLIST $matches[$i][$j]."\t";
					}
					else{
					#print "$matches[$i][$j]\n";
					print TOKENLIST $matches[$i][$j]."\t".$fields[$parse]."\t".$fields[$result]."\n";
				}
			}
		}
		print TOKENLIST ".\tpunct\t".$fields[$parse]."\t".$fields[$result]."\n"; #End of sentence  FIXME
		$tokencount++;
		$count++;
		#sleep 1;
	}
	close TOKENLIST;
	close IDS;
	close RESULT;
}

sub build_tnt_input{ #Look up tokens in lexicon and add tag/supertag
	my %lex = &index_lexicon; #get lexicon hash
	my @ids = &index_parse_ids; #get parse ids as array
	my @resultids = &index_result_ids; # get result ids as array
	my %goldhash = &make_goldlist; #make a hash of all goldtree IDs
	my $count=0;
	my $sentencecount=0;
	my $slicecount=0;
	open LOG, ">:utf8", "build_tnt_input_gold.log" or die$!;
	open TOKENLIST,  "<:utf8", "tokenlist_gold.txt" or die $!;
	my $n=0;
	my $current_id=$ids[$n];#get first parse ID
	my $previous_id=$ids[$n];#no previous ID yet, so set that to first ID
	my $goldresult=0;
	my $goldparse=0;
	while (<TOKENLIST>){ #For each token
		chomp;
		my @tfields=split(/\t/, $_,); #Split on Tabs

		#Manage slicing
		$current_id=$ids[$n];#get current parse ID					
		if ($previous_id eq $current_id){ 	#Still on the same parse
			#print LOG "NOCHANGE $previous_id\t$current_id\t$slicecount\n\n"; 
			#nothing to do go on with next token
			print "NOCHANGE Old ID $previous_id\t Cur ID $current_id\tResult $tfields[3]\tSlice $slicecount\n\n";
		}
		else{								#Parse ID has changed.
			$previous_id=$ids[$n]; #Remember old ID
			print LOG "CHANGE $previous_id\t$current_id\t$slicecount\n\n";
			print "ID CHANGE $previous_id\t$current_id\t$slicecount\n\n";
			if ($goldparse==1){ #Only switch to next slice if there was at least one gold tree gold
				if ($slicecount == 9){#We have a new parse in each slice
					$slicecount = 0; #reset the slice counter, next parse will go to slice0
				}
				else{ #Not yet at slice ten
					$slicecount++; #Next parse will go to next slice
				}
			}	
		}
		
		#Decide if token is part of a goldtree
		my @golds;
		my $goldstring;
		$goldresult=0;#reset goldflag to not gold
		if ($goldhash{$tfields[2]}){ #if the current parse ID is a key in the goldtree hash
			$goldparse=1; #we now there is at least one goldparse so we need to go to the next slice once the parse ID changes
			$goldstring = substr $goldhash{$tfields[2]}, 1; #get all gold trees for current parse
			@golds=split(/,/,$goldstring);#put the result IDs of the goldtrees for current parses in array.
				foreach (@golds){
					if($tfields[3]==$_){ #if the result ID of the current token is part of a gold result
						print "Goldflag before: $goldresult\n";
						$goldresult=1;#we found goldresult
						print "$tfields[0]\t$tfields[1]\t$goldstring: Gold found at parse $tfields[2], result $tfields[3], going to slice $slicecount\n";
						print LOG "$tfields[0]\t$tfields[1]\t$goldstring: Gold found at parse $tfields[2], result $tfields[3], going to slice $slicecount\n";
						print "Goldflag after: $goldresult\n";			
					}	
				}
		}
		
		#Open the output files
		open OUT, ">>:utf8", "slice_gold$slicecount.tt" or die $!;#Open slice TNT
		open OUT2, ">>:utf8", "slice_gold$slicecount.cc" or die $!;#Open slice CC
		#Do stuff
		if ($tfields[1] eq "punct"){#If we are at the end of a result		#FIXME
			$n++;	#increase ID counter
			#Print last token to current slice and log stuff.
			print "Build TNT-INPUT...\t$sentencecount\n";
			if ($goldresult==1){
				print OUT "\n";#FIMXE
				print OUT2 "\n";#FIMXE
				#print OUT "\n $tfields[2]\t$tfields[3]\t$previous_id\t$current_id\t$slicecount\t$sentencecount\n\n"; #DEBUG  REMOVE
			}
			$sentencecount++;
			print LOG "Slicenumber:\t$slicecount\n";
			print LOG "IDs: $previous_id\t$current_id\n";
			print LOG "Sentence:\t$sentencecount\n\n";
		}
		else{#not end of sentence
			chomp @tfields;			
			if ($lex{$tfields[0]}){ #If the pos-tag of the token is a key in the hash of lexical items
					my $lexitem=substr $lex{$tfields[0]}, 1;
					#print "-->\t".$tfields[1]."\t".$lexitem."\n\n";
					if ($goldresult==1){
						if ($tfields[1]=~/.*[.,:?!]/) #We find a punctuation char on the token
						{
							my $punct = chop($tfields[1]);
							print OUT $tfields[1]."\t".$lexitem."\n";
							print OUT2 $tfields[1]."|".$lexitem." ";
							print OUT $punct."\t".$punct."\n";
							print OUT2 $punct."|".$punct." ";
						}
						else{
							print OUT $tfields[1]."\t".$lexitem."\n"; #Write surface of token and lexical entry to file
							print OUT2 $tfields[1]."|".$lexitem." "; #Write surface of token and lexical entry to file
						}
						
					}
				}
			else{
				if ($goldresult==1){
					print OUT $tfields[1]."\tNONE\n"; #Write surface of token and NONE to file
					print OUT2 $tfields[1]."|NONE "; #Write surface of token and NONE to file
				}
			}
		 }
		$count++;
		close OUT;#close current slices
		close OUT2;
	}
	close TOKENLIST; #Were done. All tokens have been processed
}




#Helper SUBs
sub clean_slices{ #resets the TNT slice files.
	my $n=0;
	while ($n < 10){
		open OUT, ">:utf8", "slice_gold$n.tt" or die $!;
		print OUT; #Sets file to 0
		close OUT;
		print $n."\n";
		$n++;
	}
}
sub clean_slices2{ #resets the CC slice files.
	my $n=0;
	while ($n < 10){
		open OUT, ">:utf8", "slice_gold$n.cc" or die $!;
		print OUT; #Sets file to 0
		close OUT;
		print $n."\n";
		$n++;
	}
}

sub index_lexicon{ #Turns lexicon into a hash
	open LEXICON,  "<:utf8", "lexicon_trim.tdl" or die $!;
	my %hash;
	while (<LEXICON>){
		chomp;
		my ($key, $val) = split /\t/;
		$hash{$key} .= exists $hash{$key} ? ",$val" : $val;
	}
	close LEXICON;
	return %hash;
}

sub index_parse_ids{ #Turns list of parse IDs into an array
	open IDS, "<:utf8","parse_resultid.txt" or die $!;
	my @IDS;
	while (<IDS>) {
		my @fields=split(/\t/, $_,); #Split on Tabs
		my $parse_id=$fields[0]; #Get parse ID
  		push (@IDS, $parse_id); #Put parse ID into hash
	}
	close IDS;
	return @IDS; #return array of parse IDs
}

sub index_result_ids{ #Turns list of result IDs into an array
	open IDS, "<:utf8","parse_resultid.txt" or die $!;
	my @IDS;
	while (<IDS>) {
		my @fields=split(/\t/, $_,); #Split on Tabs
		my $parse_id=$fields[1]; #Get result ID
  		push (@IDS, $parse_id); #Put result ID into hash
	}
	close IDS;
	return @IDS; #return array of parse IDs
}

sub make_goldlist{ #make a hash of which results are goldtrees by looking up "preference"
	open PREF, "<:utf8","preference" or die $!;
	open LOG, ">:utf8","list_of_gold.txt" or die $!; #Make a list of parse IDs and gold result IDs for debugging
	my %hash;
	while (<PREF>){
		chomp;
		my @fields = split(/@/, $_);
		my $string = $fields[0]."\t".$fields[2];
		print LOG $string."\n";
		my ($key, $val) = split(/\t/, $string, 3);
		$hash{$key} .= exists $hash{$key} ? ",$val" : $val;
	}
	close PREF;
	return %hash;	
}

#Test for make_goldlist
#print "Testing goldlist...";
#my %hash = &make_goldlist;
#print substr $hash{"14"}, 1; #get all gold trees for parse 1341 as a test
#print %hash; #get all gold trees for parse 1341 as a test
#More than 1 goldtree per parse? WTF
#open TEST, ">:utf8","test" or die $!;
#while ((my $key, my $value) = each(%hash)){
#   print TEST $key."\t".$value."\n";
#}

#TODO:
#Get full lexicon files
#Properly handle punctuation
#Properly handele Multi-word expressions
#Unify scripts for gold and non-gold
